home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Snippets / BGHSorting / BGHSorting.p next >
Encoding:
Text File  |  1994-11-28  |  2.7 KB  |  84 lines  |  [TEXT/R*ch]
  1. Unit BGHSorting;
  2. Interface
  3.  
  4.    procedure sort(
  5.       left, right: longint;
  6.       function less_than(a,b:longint):boolean;
  7.       procedure swap(a,b:longint)
  8.    );
  9.  
  10. Implementation
  11.  
  12.    procedure sort(
  13.       left, right:longint;
  14.       function less_than(a,b:longint):boolean;
  15.       procedure swap(a,b:longint)
  16.    );
  17.    var
  18.       i, j, mid, median, small_pos: longint;
  19.    begin
  20.       while (right-left) >= 15 do begin
  21.          mid := (left+right) div 2;
  22.          
  23.          {find the Median of left, mid, right}
  24.          if less_than(left,mid) then begin
  25.             if less_than(mid,right) then median := mid
  26.             else if less_than(left,right) then median := right
  27.             else median := left
  28.          end else begin
  29.             if less_than(left,right) then median := left
  30.             else if less_than(mid,right) then median := right
  31.             else median := mid;
  32.          end; {finding the median}
  33.          
  34.          {
  35.             partition the region into three:
  36.             
  37.             left <= x <= j:  those smaller than median
  38.             j < x < i:       those equal to median
  39.             i <= x <= right: those greater than median
  40.          }
  41.          i := left;
  42.          j := right;
  43.          while i <= j do begin
  44.             while (i<right) & less_than(i,median) do i := i + 1;
  45.             while (j>left)  & less_than(median,j) do j := j - 1;
  46.             if i <= j then begin
  47.                if i < j then begin
  48.                   {watch for median getting moved under us!}
  49.                   if median = i      then median := j
  50.                   else if median = j then median := i;
  51.                   swap(i,j);
  52.                end;
  53.                {no need to look at these two again}
  54.                i := i + 1;
  55.                j := j - 1;
  56.             end;
  57.          end;
  58.          {skip over any items equal to the guess of the median}
  59.          while (i<right) & not less_than(median,i) do i := i + 1;
  60.          while (j>left)  & not less_than(j,median) do j := j - 1;
  61.          
  62.          {now sort the two halves}
  63.          if (j-left) < (right-i) then begin
  64.             {the left half is smaller -- sort it recursively first}
  65.             sort(left,j,less_than,swap);
  66.             left := i; {prepare for next iteration}
  67.          end else begin
  68.             {the right half is smaller -- sort it recursively first}
  69.             sort(i,right,less_than,swap);
  70.             right := j; {prepare for next iteration}
  71.          end;
  72.       end; {while more than xxx elements to sort}
  73.       
  74.       {now selection sort any remaining elements}
  75.       for i := left to right-1 do begin
  76.          small_pos := i;
  77.          for j := i+1 to right do if less_than(j,small_pos) then small_pos := j;
  78.          if small_pos <> i then swap(i,small_pos);
  79.       end;
  80.       
  81.    end; {sort}
  82.  
  83. end.
  84.